home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_nn-tk.idb / usr / freeware / lib / nn / tcl / config.tcl.z / config.tcl
Encoding:
Text File  |  1999-04-16  |  20.3 KB  |  852 lines
  1. #
  2. # user defined menu entries
  3. #
  4. proc table_Make {w v opts cu du} {
  5.     global Config 
  6.     upvar #0 $v vec
  7.  
  8.     toplevel .$w
  9.     wm minsize .$w 0 0
  10.  
  11.     frame .$w.b
  12.     button .$w.b.h -text "Help" -command "put_extended {help nn-tk-$w}"
  13.     button .$w.b.c -text "Cancel" -command "destroy .$w"
  14.     button .$w.b.a -text "Apply" -command "${w}_done 0"
  15.     button .$w.b.s -text "Save" -command "${w}_done 1"
  16.     pack .$w.b.h  .$w.b.c  .$w.b.a  .$w.b.s  -side right
  17.     pack .$w.b  -fill x
  18.  
  19.     message .$w.t -text $vec(0) -width 300 \
  20.         -font [option get . option_bold_font {} ] 
  21.     pack  .$w.t -side top
  22.  
  23.     frame .$w.l
  24.     label .$w.l.l -text "   "
  25.     label .$w.l.com -text $vec(1) -width 45
  26.     label .$w.l.des -text $vec(2)  -width 15
  27.  
  28.     pack .$w.l.l -side left
  29.     pack .$w.l.com -side left -fill x -expand yes
  30.     pack .$w.l.des -side left -fill x -expand yes
  31.     pack .$w.l -side top -fill x -expand yes
  32.  
  33.     set n 1
  34.     foreach m [option get $opts entrylist {} ] {
  35.     table_lines $w $n $m $cu $du
  36.     incr n
  37.     }
  38.  
  39.     if {[info exists Config(.$w)]} {
  40.     wm geometry .$w $Config(.$w)
  41.     }
  42.     balloonHelp_traverse .$w
  43. }
  44.  
  45. proc table_lines {w n m c d} {
  46.     upvar #0 $c cu
  47.     upvar #0 $d du
  48.  
  49.     frame .$w.l$n
  50.     label .$w.l$n.l -text " $m "
  51.     entry .$w.l$n.com -relief sunken -width 45
  52.     .$w.l$n.com delete 0 999
  53.     .$w.l$n.com insert 0 $cu($m)
  54.  
  55.     entry .$w.l$n.des -relief sunken -width 15
  56.  
  57.     .$w.l$n.des delete 0 999
  58.     .$w.l$n.des insert 0 $du($m)
  59.     label .$w.l$n.ll -text "   "
  60.     pack  .$w.l$n.l -side left
  61.     pack  .$w.l$n.com .$w.l$n.des -side left -fill x -expand yes
  62.     pack  .$w.l$n.ll -side left 
  63.     pack  .$w.l$n -side top -fill x -expand yes
  64. }
  65.  
  66. proc user_done {save} {
  67.     global com_user des_user
  68.  
  69.     set i 1
  70.     .top.macro.m delete 0 last
  71.     foreach m [option get .top.macro.m entrylist {} ] {
  72.     set  com_user($m) [.user.l$i.com get]
  73.     set  des_user($m) [.user.l$i.des get]
  74.         .top.macro.m add command -label $des_user($m) -command \
  75.                 "put_extended {$com_user($m)}"
  76.     incr i
  77.     }
  78.  
  79.     if {$save} {
  80.     config_save
  81.     }
  82.     destroy .user
  83. }
  84.  
  85. proc color_done {save} {
  86.     global col_pattern col_name
  87.  
  88.     group_color_clear
  89.     set i 1
  90.     foreach m [option get .groups.list entrylist {} ] {
  91.     set  col_pattern($m) [.color.l$i.com get]
  92.     set  col_name($m) [.color.l$i.des get]
  93.     if {$col_pattern($m) != ""} {
  94.         group_color $col_pattern($m) $col_name($m)
  95.     }
  96.     incr i
  97.     }
  98.     list_flag_raise
  99.     if {$save} {
  100.     config_save
  101.     }
  102.     destroy .color
  103. }
  104.  
  105. proc user_menu {menu} {
  106.     global com_user des_user
  107.  
  108.     foreach m [option get $menu entrylist {} ] {
  109.     set des_user($m) [option get $menu l_$m {}]
  110.     set com_user($m) [option get $menu c_$m {}]
  111.     $menu add command -label $des_user($m) -command \
  112.         "put_extended {$com_user($m)}"
  113.     }
  114. }
  115.  
  116. proc setup_menu {menu} {
  117.     global com_user des_user
  118.  
  119.     foreach m [option get $menu entrylist {} ] {
  120.     set des_user($m) [option get $menu l_$m {}]
  121.     set com_user($m) [option get $menu c_$m {}]
  122.     $menu add command -label $des_user($m) -command \
  123.         "$com_user($m)"
  124.     }
  125. }
  126.  
  127. proc color_group {menu} {
  128.     global col_pattern col_name
  129.  
  130.     foreach m [option get $menu entrylist {} ] {
  131.     if {$col_pattern($m) != ""} {
  132.         group_color $col_pattern($m) $col_name($m)
  133.     }
  134.     }
  135.     list_flag_raise
  136. }
  137.  
  138. #
  139. #    Options
  140. #
  141. proc config_save_geom {} {
  142.     config_layout
  143.     config_save
  144. }
  145.  
  146. proc config_layout {}  {
  147.     global Config config_windows
  148.  
  149.     set Config(.nn) [wm geometry .]
  150.     foreach i $config_windows {
  151.     catch {
  152.         if {[winfo exists $i]} {
  153.         set Config($i) [wm geometry $i]
  154.         }
  155.     }
  156.     }
  157. }
  158.  
  159. proc config_read {} {
  160.     global nn_directory Config config_windows config_var nn_x_dir
  161.     global col_pattern col_name
  162.  
  163.      if [catch {option readfile "$nn_x_dir/tcl/nn-defaults" user} err] {
  164.        tkerror "nn-defaults error: $err"
  165.      }
  166.     if [file exists $nn_directory/nn-defaults] {
  167.        if [catch {option readfile "$nn_directory/nn-defaults" user} err] {
  168.            tkerror "nn-defaults error: $err"
  169.        }
  170.     }
  171.  
  172.     if [file exists $nn_directory/tk-config] {
  173.        if [catch {option readfile "$nn_directory/tk-config" user} err] {
  174.            tkerror "tk-config error: $err"
  175.        }
  176.     }
  177.  
  178. # need .top.option to exist
  179.     frame .top
  180.     frame .top.option
  181.     foreach i [option get .top.option entrylist {} ] {
  182.     lappend opts ".variables_$i"
  183.     }
  184.     set config_windows [concat $config_windows $opts]
  185.     destroy .top.option
  186.     destroy .top
  187.  
  188.  
  189.     foreach i $config_windows {
  190.     if [winfo exists $i] {
  191.         set Config($i) [option get  ${i} position {}]
  192.     } else {
  193. #           workaround for requirement for window to exist
  194. #           before can get option
  195.         frame $i
  196.         set p [option get ${i} position {}]
  197.         if {$p != ""} {
  198.         set Config($i) $p
  199.         }
  200.         destroy $i
  201.     }
  202. #    puts "$i $Config($i)"
  203.     }
  204.     foreach i $config_var  {
  205.     if {[option get . $i {}] != "" } {
  206.         set Config($i) [option get . $i {}]
  207.     } else {
  208.         set Config($i) ""
  209.     }
  210. #    puts "=$i $Config($i)"
  211.     }
  212.     frame .groups
  213.     frame .groups.list
  214.     foreach m [option get .groups.list entrylist {} ] {
  215.     set col_pattern($m) [option get .groups.list l_$m {}]
  216.     set col_name($m) [option get .groups.list c_$m {}]
  217.     }
  218.     destroy .groups.list
  219.     destroy .groups
  220.     
  221.     config_temp
  222. }
  223.  
  224. proc config_temp {} {
  225.     global Config TConfig 
  226.  
  227.     set TConfig(mono_font) $Config(mono_font)
  228.     set TConfig(balloon_on) $Config(balloon_on)
  229.  
  230.     set TConfig(prefetch_on) [nn_get_var prefetch]
  231. }
  232.  
  233. proc config_save {} {
  234.     global Config nn_directory config_windows config_var
  235.     global has_exmh
  236.  
  237.     set fname "$nn_directory/tk-config"
  238.     set f [open $fname w]
  239.  
  240.     foreach i [lsort $config_windows] {
  241.     set s [string range $i 1 end]
  242.     if {[info exists Config($i)] && $Config($i) != ""} {
  243.         set Config($i) [config_check_geom $Config($i)]
  244.         puts $f "*$s.position: $Config($i)"
  245.     }
  246.     }
  247.     puts $f "!!"
  248.     foreach i [lsort $config_var] {
  249.     puts $f "*$i: $Config($i)"
  250.     }
  251.     puts $f "!!"
  252.     global com_user des_user  
  253.     foreach m [option get .top.macro.m entrylist {} ] {
  254.     puts $f "*top.macro.m.l_$m:    $des_user($m)"
  255.     puts $f "*top.macro.m.c_$m:    $com_user($m)"
  256.     }
  257.     puts $f "!!"
  258.     global col_pattern col_name
  259.     foreach m [option get .groups.list entrylist {} ] {
  260.     puts $f "*groups.list.l_$m:    $col_pattern($m)"
  261.     puts $f "*groups.list.c_$m:    $col_name($m)"
  262.     }
  263.     close $f
  264.     if {$has_exmh} {
  265.     nn_PreferencesSave
  266.     }
  267. }
  268.  
  269. proc config_check_geom {g} {
  270.     scan $g "%dx%d+%d+%d" xs ys xp yp
  271.     if {$xs < 0} {
  272.     set xs 0
  273.     }
  274.     if {$ys < 0} {
  275.     set ys 0
  276.     }
  277.     return [format "%dx%d+%d+%d"  $xs $ys $xp $yp]
  278. }
  279.  
  280. #
  281. # nn specific variable setting
  282. #
  283. # variables_m    - variables modified from default
  284. # variables_prev - original value of variables
  285. # variables_val  - value used by widgets
  286. # variables_ch   - variables  that have changed
  287.  
  288. proc variables_Make {sel lab} {
  289.     global variables_local variables_toggled
  290.     global variables_ch variables_m variables_val variables_prev variables_help
  291.  
  292.     set variables_local 0
  293.     set variables_toggled 0
  294.  
  295.     if {[info exists variables_ch]} {
  296.     unset variables_ch
  297.     }
  298.     set variables_ch(1) 1
  299.     unset variables_ch(1)
  300.     if {[info exists variables_m]} {
  301.     unset variables_m
  302.     }
  303.     set variables_m(1) 1
  304.     unset variables_m(1)
  305.     if {[info exists variables_val]} {
  306.     unset variables_val
  307.     }
  308.     set variables_val(1) 1
  309.     unset variables_val(1)
  310.     if {[info exists variables_prev]} {
  311.     unset variables_prev
  312.     }
  313.  
  314.     if {$sel == "a"} {
  315.     set label "NN variables (all)"
  316.     set vars [nn_variables a]
  317.     } elseif {$sel == "m"}  {
  318.     set label "NN variables (modified)"
  319.     set vars [nn_variables m]
  320.     } else {
  321.     set label "NN variables - $lab"
  322. #       always show variables toggled by nn-tk command line
  323.     set vars [concat [option get .top.option $sel {} ] [nn_variables t]]
  324.     }
  325.     set cmd "variables_some \"$vars\""
  326.  
  327.     opt_Make variables_$sel variables  variables_some $vars $label
  328. }
  329.  
  330. proc variables_some {section window} {
  331. #    puts "$section $window"
  332.     foreach m  $section  {
  333.     variables_ent  $window $m
  334. #    puts "nn_variable $m $window"
  335.     }
  336. }
  337.  
  338. proc variables_ent {w name} {
  339.     global variables_m 
  340. #          nn variable modified from default
  341.     global variables_prev
  342. #          The value of the nn variable (may have arbitrary characters)
  343.     global variables_local variables_toggled
  344. #          an nn local value enountered
  345.  
  346.     nn_get_var_info $name
  347. #          current value, type, tag of nn variable
  348.     global var_str var_type var_tg            
  349.     
  350.     if {$var_str == "NULL"} {
  351.     set var_str ""
  352.     }
  353.     set variables_prev($name) $var_str
  354.  
  355.     set local 0
  356.     set tag $var_tg
  357.     set type $var_type
  358.  
  359.     if {$tag == "m"} {
  360.     set variables_m($name) 1
  361.     } elseif {$tag == "p"} {
  362.     set local 1
  363.     if {! $variables_local} {
  364.         set variables_local  1
  365.         msg_warn "WARNING - There are local variables, if saved these will replace the corresponding global ones"
  366.     }
  367.     } elseif {$tag == "t"} {
  368.     set local 2
  369.     if {! $variables_toggled} {
  370.         set variables_toggled  1
  371.         msg_warn "WARNING - There are variables toggled by NN parameters, if saved these may have an undesired values"
  372.     }
  373.     }
  374.     opt_item $w variables $name $type "" $name $local 1
  375. }
  376.  
  377. proc variables_done {w save} {
  378.      global variables_ch variables_prev variables_m variables_val print
  379.  
  380.     foreach i [array names variables_ch] {
  381.     nn_set_var $i $variables_ch($i)
  382. #       nn_set_var doesn't return sucess or failure so
  383. #       so need to check if variable changed
  384.         global change_var
  385.     if {$variables_ch($i) == [nn_get_var $i]} {
  386.         set variables_m($i) 1
  387.         set variables_prev($i) $variables_ch($i)
  388.         set variables_val($i) $variables_ch($i)
  389.     } else {
  390.         nn_set_var $i $variables_prev($i)
  391.         set variables_ch($i) $variables_prev($i)
  392.         set variables_val($i) $variables_prev($i)
  393.         return
  394.     }
  395.     }
  396.     if {[info exists variables_ch(printer)]} {
  397.     set print(cmd) "cat \$file | $variables_ch(printer)"
  398.     }
  399.     if {$save} {
  400.     variables_save
  401.     }
  402.     destroy .$w
  403.     msg_destroy
  404. }
  405.  
  406. proc variables_save {} {
  407.     global nn_directory
  408.     global variables_m variables_val
  409.  
  410.     set vars [nn_variables m]
  411.     foreach i $vars {
  412.     if {![info exists variables_val($i)]} {
  413.         set variables_m($i) 1
  414.         set variables_val($i) [nn_get_var $i]
  415.     }
  416.     }
  417.     
  418.     set fname "$nn_directory/tk-init-nn"
  419.     set f [open $fname w]
  420.     foreach i [array names variables_m] {
  421.     puts  $f "set $i $variables_val($i)"
  422.     }
  423.     close $f
  424.     msg_destroy
  425. }
  426.  
  427. #
  428. # nn-tk specific option setting
  429. #
  430.  
  431. proc options_fill {vlist vname} {
  432.     global options_prev Config config_var options_val options_ch
  433.     global options_type options_header options_other
  434.  
  435.     catch {
  436.     unset options_val
  437.     unset options_ch
  438.     }
  439.  
  440.     foreach i $vlist   {
  441.     set options_prev($i) $Config($i)
  442.     if {[info exists options_type($i)]} {
  443.         opt_item $vname options $i $options_type($i) $options_header($i) \
  444.         [if {[info exists options_other($i)]} {
  445.             set x $options_other($i)
  446.         } else {
  447.             set x ""
  448.         }]
  449.     } else {
  450.         opt_item $vname options $i
  451.     }
  452.     }
  453. }
  454.  
  455. proc options_done {w save} {
  456.     global menu_mode options_ch options_prev options_val Config 
  457.  
  458.     set do_list  0
  459.     set do_listc  0
  460.     set do_listt  0
  461.     set do_menu  0
  462.     set do_prompt 0
  463.     if {[info exists options_ch]} {
  464.     foreach i [array names options_ch] {
  465.         switch -exact -- $i {
  466.         middle_button_pos {
  467.             middle_buttons
  468.             if {$Config(middle_button_pos) == 1} {
  469.             pack  .middle -side top -after .top
  470.             } elseif {$Config(middle_button_pos) == 2} {
  471.             pack  .middle -side top -after .menu-pr
  472.             } else {
  473.             pack  .middle -side top -after .more
  474.             }
  475.         }
  476.         menu_min {
  477.             set options_val($i) [.$w.c.f.menu_max.mmin get]
  478.         }
  479.         menu_max {
  480.             set options_val($i) [.$w.c.f.menu_max.mmax get]
  481.         }
  482.         horizontal_scrollbars {
  483.                     m_scrollbar .more.t .more.sx $options_val(horizontal_scrollbars)
  484.                     m_scrollbar .menu.article .menu.sx $options_val(horizontal_scrollbars)
  485.         }
  486.         thread_height {
  487.             set options_val($i) [.$w.c.f.$i.s get]
  488.             .groups.c configure -height $options_val($i) -scrollregion {0 0 1500 1000}
  489.  
  490.                     if {$options_val($i) != 0} {
  491.                         pack .groups.thr.x -side bottom -fill x
  492.                         pack .groups.thr.y -side right -fill y
  493.                         pack .groups.c -side top  -fill both -in .groups.thr
  494.                         pack .groups.thr -side top  -fill both -before .groups.t
  495.                     } else {
  496.                         pack forget .groups.thr
  497.                     }
  498.  
  499.         }
  500.         single_main {
  501.             set do_list 1
  502.         }
  503.         separate_prompt {
  504.             set do_prompt 1
  505.         }
  506.         compressed_prompt {
  507.             set do_prompt 1
  508.         }
  509.         group_list_read {
  510.             set do_listc 1
  511.         }
  512.         group_list_unsub {
  513.             set do_listc 1
  514.         }
  515.         group_list_all {
  516.             set do_listc 1
  517.         }
  518.         group_list_width {
  519.             set options_val($i) [.$w.c.f.$i.s get]
  520.             set do_listt 1
  521.         }
  522.         group_menu_read {
  523.             set do_menu 1
  524.         }
  525.         group_menu_unsub {
  526.             set do_menu 1
  527.         }
  528.         group_menu_length {
  529.             set do_menu 1
  530.         }
  531.         }
  532.         set Config($i) $options_val($i)
  533.     }
  534.     }
  535.     if {$save == 1} {
  536.     config_save
  537.     }
  538.     set_option_values
  539.     if {$do_list} {
  540.     list_reset
  541.     } elseif {$do_listc} {
  542.     list_clear
  543.     } elseif {$do_listt} {
  544.     list_cl
  545.     }
  546.     if {$do_menu == "1"} {
  547.     destroy .top.m.menu
  548.     menu .top.m.menu
  549.     foreach i [info commands .top.m.menu-*] {
  550.         catch {destroy $i}
  551.     }
  552.     msg_Make "Making group cascading menus" 0
  553.     update
  554.     grp_menu
  555.     msg_destroy
  556.     }
  557.     if ($do_prompt) {
  558.     destroy .prompt
  559.     prompt_Make
  560.     if {($Config(separate_prompt) == 0) && ($Config(compressed_prompt) != 2)} {
  561.         pack .prompt -side top -fill x
  562.     }
  563.     }
  564.     destroy .$w
  565. }
  566.  
  567. #
  568. # Generic options setting code
  569. #
  570. proc opt_button {var l} {
  571.     upvar #0 ${var}_ch var_ch
  572.     upvar #0 ${var}_val var_val
  573.     set var_ch($l)  $var_val($l)
  574. }
  575.  
  576. proc opt_radio {var str name args} {
  577.  
  578.     set n 0
  579.     foreach i $args {
  580.     radiobutton $str.$n -text $i -variable ${var}_val($name) \
  581.         -value $n -relief flat -command "opt_button $var $name"
  582.     pack $str.$n -side top -pady 2 -padx 3 -anchor w
  583.     incr n
  584.     }
  585. }
  586.  
  587. proc opt_check_int {name element op} {
  588.     regexp {^[^_]*} $name var
  589.  
  590.     upvar #0 ${var}_val var_val
  591.     upvar #0 ${var}_ch var_ch
  592.     upvar #0 ${var}_prev var_prev
  593.  
  594.     if {[regexp {^[0-9\-]*$} $var_val($element)]} {
  595.     set var_ch($element) $var_val($element)
  596.     } else {
  597.     set var_val($element) $var_prev($element)
  598.     }
  599. }
  600.  
  601. proc opt_check_key {name element op} {
  602.     regexp {^[^_]*} $name var
  603.  
  604.     upvar #0 ${var}_val var_val
  605.     upvar #0 ${var}_ch var_ch
  606.  
  607.     set var_ch($element) $var_val($element)
  608. }
  609.  
  610. proc opt_check_str {name element op} {
  611.     regexp {^[^_]*} $name var
  612.  
  613.     upvar #0 ${var}_val var_val
  614.     upvar #0 ${var}_ch var_ch
  615.  
  616.     set var_ch($element) $var_val($element)
  617. }
  618.  
  619. proc opt_help_item {w v name} {
  620.     upvar #0 ${v}_help var_help 
  621.  
  622.     .$w.m.t delete 0.0 end
  623.     if {[info exists var_help($name)]} {
  624.     .$w.m.t insert 0.0 $var_help($name)
  625.     }
  626. }
  627.  
  628. proc opt_h_mmin {val} {
  629.     global options_ch
  630.     set options_ch(menu_max) 1
  631.  
  632.     set maxv [.vars_misc.c.f.menu_max.mmax get]
  633.     if {$maxv < $val} {
  634.     .vars_misc.c.f.menu_max.mmax set $val
  635.     }
  636. }
  637.  
  638. proc opt_h_mmax {val} {
  639.     global options_ch
  640.     set options_ch(menu_min) 1
  641.  
  642.     set minv [.vars_misc.c.f.menu_max.mmin get]
  643.     if {$minv > $val} {
  644.     .vars_misc.c.f.menu_max.mmin set $val
  645.     } 
  646. }
  647.  
  648. proc opt_scale {name val} {
  649.     global $name options_ch options_prev
  650.     if {$val != $options_prev($name)} {
  651.     set options_ch($name) 1
  652.     }
  653. }
  654.  
  655. proc opt_item {w v name {type ""}  {desc ""}  {other ""} {local 0} {bonoff 0}} {
  656.     upvar #0 ${v}_val var_val 
  657.     #         new varlue of variable
  658.     upvar #0 ${v}_prev var_prev 
  659.     global butt 
  660.     #         radio button names for variable
  661.  
  662.     set var_val($name) $var_prev($name)
  663.     if {$desc == ""} {
  664.     set desc $name
  665.     }
  666.  
  667.     frame .$w.c.f.$name -borderwidth 2  -relief ridge
  668.  
  669.     switch -regexp -- $type \
  670.     bool {
  671.         checkbutton .$w.c.f.$name.b -variable ${v}_val($name) \
  672.         -text $desc -command "opt_button $v $name" \
  673.         -relief flat
  674.         if {$bonoff} {
  675.         .$w.c.f.$name.b configure -offvalue off -onvalue on
  676.         }
  677.         pack  .$w.c.f.$name.b -anchor w -padx 8
  678.     }\
  679.     int|key {
  680.         label .$w.c.f.$name.m -text $desc 
  681.         if {[info exists butt($name)]} {
  682.         pack  .$w.c.f.$name.m  -side top -padx 8
  683.         eval "opt_radio $v .$w.c.f.$name $name \
  684.             $butt($name)"
  685.         } else {
  686.         pack .$w.c.f.$name.m  -side left -padx 8
  687.         entry  .$w.c.f.$name.e -relief sunken -width 7 \
  688.             -textvariable ${v}_val($name)
  689.         pack .$w.c.f.$name.e -side right -anchor e  -padx 8
  690.         if {$type == "int"} {
  691.             trace variable var_val($name) w opt_check_int
  692.         } else {
  693.             trace variable var_val($name) w opt_check_key
  694.         }
  695.         }
  696.     }\
  697.     str|spec|code {
  698.         label .$w.c.f.$name.m -text $desc
  699.         entry  .$w.c.f.$name.e -relief sunken \
  700.         -textvariable ${v}_val($name)
  701.         trace variable var_val($name) w opt_check_str
  702.         pack  .$w.c.f.$name.m  -expand yes
  703.         pack  .$w.c.f.$name.e -expand yes -pady 3 -fill x -padx 8
  704.     }\
  705.     slider {
  706.         scale .$w.c.f.$name.s -label $desc  -from [lindex $other 0]\
  707.         -to [lindex $other 1]\
  708.         -orient horizontal -command "opt_scale $name"
  709.         pack .$w.c.f.$name.s -fill x
  710.         global ${v}_val
  711.         .$w.c.f.$name.s set [set ${v}_val($name)]
  712.     }\
  713.     panel {
  714.         #   special case - menu size 
  715.         scale .$w.c.f.$name.mmax -label "Menu panel max size" -from 1 -to 100  \
  716.         -orient horizontal   -command "opt_h_mmax"
  717.         .$w.c.f.$name.mmax set $var_prev(menu_max)
  718.         scale .$w.c.f.$name.mmin -label "Menu pane min size" -from 1 -to 100  \
  719.         -orient horizontal   -command "opt_h_mmin"
  720.         .$w.c.f.$name.mmin set $var_prev(menu_min)
  721.         pack .$w.c.f.$name.mmax .$w.c.f.$name.mmin -side top -fill x
  722.     }\
  723.     "" {
  724.     }\
  725.     default {
  726.         puts "$name TYPE=$type"
  727.     }
  728.  
  729.     pack .$w.c.f.$name  -side top -pady 2 -expand yes \
  730.     -anchor w -fill x
  731.     bind  .$w.c.f.$name <Enter> \
  732.     "opt_help_item $w $v $name"
  733.  
  734.     upvar #0 ${v}_help var_help
  735.     if {[info exists var_help($name)]} {
  736.     balloonHelp .$w.c.f.$name $var_help($name)
  737.     }
  738.  
  739.     if {$local} {
  740.     .$w.c.f.$name configure -borderwidth 6 -relief sunken
  741.     }
  742. }
  743.  
  744. proc opt_read_help {v} {
  745.     global help_directory ${v}_help
  746.  
  747.     set fname "$help_directory/help.$v"
  748.     if {[file  exists $fname]} {
  749.         set f [open $fname r]
  750.         while {[gets $f line] >= 0} {
  751.         set nst [string first "\t" $line ]
  752.         set nss [string first " " $line ]
  753.         if {$nss> 0 && $nss < $nst} {
  754.         set nst $nss
  755.         }
  756.         set nf [string last  "\t" $line ]
  757.         set var [string range $line 0 [incr nst -1]]
  758.         set comm [string range $line [incr nf] end]
  759.         set ${v}_help($var) $comm
  760.     }
  761.     close $f
  762.     }
  763. }
  764.  
  765. proc opt_help {v label vars} {
  766.     upvar ${v}_help help
  767.  
  768.     display_Make
  769.  
  770.     .display.t insert end "\t\t"
  771.     .display.t insert end "$label" out
  772.  
  773.     foreach n $vars {
  774.     .display.t insert end "\n\n"
  775.     .display.t insert end "$n" out
  776.     .display.t insert end "\n"
  777.     if {[info exists help($n)]} {
  778.         .display.t insert end $help($n)
  779.     }
  780.     }
  781.  
  782. }
  783.  
  784. proc opt_Make {w v var_fill vars label} {
  785.     global  Config $w color_bd
  786.  
  787.     if {![info exists ${v}_help]} {
  788.     opt_read_help $v
  789.     }
  790.  
  791.     if {[winfo exists .$w]} {
  792.     return
  793.     }
  794.     toplevel .$w
  795.     wm minsize .$w 0 0
  796.  
  797.     frame .$w.x 
  798.     button .$w.x.save -text "Save" -command "${v}_done $w 1"
  799.     pack  .$w.x.save  -side right 
  800.     button .$w.x.apply  -text "Apply" -command "${v}_done $w 0"
  801.     pack .$w.x.apply -side right 
  802.     button .$w.x.cancel  -text "Cancel" -command "msg_destroy\ndestroy .$w"
  803.     pack .$w.x.cancel -side right
  804.     button .$w.x.help  -text "Help" -command "opt_help $v \"$label\" \"$vars\""
  805.     pack .$w.x.help -side right
  806.  
  807.     pack .$w.x -fill x
  808.  
  809.     frame .$w.f
  810.  
  811.     label .$w.l -text $label -relief raised -pady 6 -bg $color_bd 
  812.     pack .$w.l -fill both 
  813.  
  814.     frame .$w.m -relief raised -borderwidth 2 
  815.     text .$w.m.t  -relief raised -width 20\
  816.         -height 2 -font [option get . option_bold_font {} ] -wrap word
  817.     pack .$w.m.t  -expand yes  -fill both
  818.     pack .$w.m -fill x  
  819.  
  820.     canvas .$w.c 
  821.     frame .$w.c.f
  822.  
  823.     set id [.$w.c create window 0 0 -window .$w.c.f -anchor nw]
  824.  
  825.     scrollbar .$w.s1 -command ".$w.c yview" -relief sunk
  826.     .$w.c config  -yscrollcommand ".$w.s1 set"
  827.  
  828.     pack .$w.s1 -in .$w.f -fill y -side right -expand yes \
  829.         -anchor w
  830.     pack .$w.c -in .$w.f -anchor w -expand yes -fill both
  831.  
  832.  
  833.     balloonHelp_traverse .$w
  834.  
  835.     eval "$var_fill \"$vars\" $w"
  836.  
  837.     pack .$w.f -expand yes -fill y
  838.  
  839.  
  840.     if {[info exists Config(.$w)]} {
  841.     wm geometry .$w $Config(.$w)
  842.     }
  843.     update
  844.  
  845.     if {![info exists Config(.$w)]} {
  846.     .$w.c configure -width [lindex [.$w.c bbox  $id] 2]
  847.     .$w.c configure -height [option get .top.option default_length {} ]
  848.     }
  849.     .$w.c configure -scrollregion [.$w.c bbox  $id]
  850. }
  851.  
  852.